home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / ada / gnat1792.zip / gnat179b / t-adainc / a-stwise.adb < prev    next >
Text File  |  1994-05-19  |  10KB  |  322 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT RUNTIME COMPONENTS                          --
  4. --                                                                          --
  5. --              A D A . S T R I N G S . W I D E _ S E A R C H               --
  6. --                                                                          --
  7. --                                 B o d y                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.2 $                              --
  10. --                                                                          --
  11. --           Copyright (c) 1992,1993,1994 NYU, All Rights Reserved          --
  12. --                                                                          --
  13. -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14. -- terms of the  GNU General Public License as published  by the Free Soft- --
  15. -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16. -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17. -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18. -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19. -- for  more details.  You should have  received  a copy of the GNU General --
  20. -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21. -- to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. --
  22. --                                                                          --
  23. ------------------------------------------------------------------------------
  24.  
  25. --  Note: This code is derived from the ADAR.CSH public domain Ada 83
  26. --  versions of the Appendix C string handling packages (code extracted
  27. --  from Ada.Strings.Fixed). A significant change is that we optimize the
  28. --  case of identity mappings for Count and Index, and also Index_Non_Blank
  29. --  is specialized (rather than using the general Index routine).
  30.  
  31.  
  32. with Ada.Characters;
  33.  
  34. package body Ada.Strings.Wide_Search is
  35.  
  36.    -----------------------
  37.    -- Local Subprograms --
  38.    -----------------------
  39.  
  40.    function Belongs (Element : Wide_Character;
  41.                      Set     : Wide_Maps.Wide_Character_Set;
  42.                      Test    : Membership)
  43.      return Boolean;
  44.    pragma Inline (Belongs);
  45.    --  Determines if the given element is in (Test = Inside) or not in
  46.    --  (Test = Outside) the given character set.
  47.  
  48.    -------------
  49.    -- Belongs --
  50.    -------------
  51.  
  52.    function Belongs (Element : Wide_Character;
  53.                      Set     : Wide_Maps.Wide_Character_Set;
  54.                      Test    : Membership)
  55.      return Boolean is
  56.    begin
  57.       if Test = Inside then
  58.          return Element in Set'range and then Set (Element);
  59.       else
  60.          return Element not in Set'range or else not Set (Element);
  61.       end if;
  62.    end Belongs;
  63.  
  64.    -----------
  65.    -- Count --
  66.    -----------
  67.  
  68.    function Count (Source   : in Wide_String;
  69.                    Pattern  : in Wide_String;
  70.                    Mapping  : in Wide_Maps.Wide_Character_Mapping :=
  71.                                           Wide_Maps.Identity)
  72.      return Natural
  73.    is
  74.       N : Natural;
  75.       J : Natural;
  76.  
  77.    begin
  78.       --  Handle the case of non-identity mappings by creating a mapped
  79.       --  string and making a recursive call using the identity mapping
  80.       --  on this mapped string. We identify the identity mapping by the
  81.       --  fact that our standard representation for Identity is empty.
  82.  
  83.       if Mapping'Last < Mapping'First then
  84.          declare
  85.             Mapped_Source : Wide_String (Source'range);
  86.  
  87.          begin
  88.             for J in Source'range loop
  89.                if Source (J) in Mapping'range then
  90.                   Mapped_Source (J) := Mapping (Source (J));
  91.                else
  92.                   Mapped_Source (J) := Source (J);
  93.                end if;
  94.             end loop;
  95.  
  96.             return Count (Mapped_Source, Pattern);
  97.          end;
  98.       end if;
  99.  
  100.       if Pattern = "" then
  101.          raise Pattern_Error;
  102.       end if;
  103.  
  104.       N := 0;
  105.       J := Source'First;
  106.  
  107.       while J <= Source'Last - (Pattern'Length - 1) loop
  108.          if Source (J .. J + (Pattern'Length - 1)) = Pattern then
  109.             N := N + 1;
  110.             J := J + Pattern'Length;
  111.          else
  112.             J := J + 1;
  113.          end if;
  114.       end loop;
  115.  
  116.       return N;
  117.    end Count;
  118.  
  119.    function Count (Source   : in Wide_String;
  120.                    Pattern  : in Wide_String;
  121.                    Mapping  : in Wide_Maps.Wide_Character_Mapping_Function)
  122.      return Natural
  123.    is
  124.       Mapped_Source : Wide_String (Source'range);
  125.  
  126.    begin
  127.       for J in Source'range loop
  128.          Mapped_Source (J) := Mapping (Source (J));
  129.       end loop;
  130.  
  131.       return Count (Mapped_Source, Pattern);
  132.    end Count;
  133.  
  134.    function Count (Source : in Wide_String;
  135.                    Set    : in Wide_Maps.Wide_Character_Set)
  136.      return Natural
  137.    is
  138.       N : Natural := 0;
  139.  
  140.    begin
  141.       for I in Source'range loop
  142.          if Source (I) in Set'range and then Set (Source (I)) then
  143.             N := N + 1;
  144.          end if;
  145.       end loop;
  146.  
  147.       return N;
  148.    end Count;
  149.  
  150.    ----------------
  151.    -- Find_Token --
  152.    ----------------
  153.  
  154.    procedure Find_Token (Source : in Wide_String;
  155.                          Set    : in Wide_Maps.Wide_Character_Set;
  156.                          Test   : in Membership;
  157.                          First  : out Positive;
  158.                          Last   : out Natural) is
  159.    begin
  160.       for I in Source'range loop
  161.          if Belongs (Source (I), Set, Test) then
  162.             First := I;
  163.  
  164.             for J in I + 1 .. Source'Last loop
  165.                if not Belongs (Source (J), Set, Test) then
  166.                   Last := J - 1;
  167.                   return;
  168.                end if;
  169.             end loop;
  170.  
  171.             --  Here if I indexes 1st char of token, and all chars
  172.             --  after I are in the token
  173.  
  174.             Last := Source'Last;
  175.             return;
  176.          end if;
  177.       end loop;
  178.  
  179.       --  Here if no token found
  180.  
  181.       First := Source'First;
  182.       Last  := 0;
  183.    end Find_Token;
  184.  
  185.    -----------
  186.    -- Index --
  187.    -----------
  188.  
  189.    function Index (Source   : in Wide_String;
  190.                    Pattern  : in Wide_String;
  191.                    Going    : in Direction := Forward;
  192.                    Mapping  : in Wide_Maps.Wide_Character_Mapping :=
  193.                                           Wide_Maps.Identity)
  194.      return Natural is
  195.  
  196.    begin
  197.       --  Handle the case of non-identity mappings by creating a mapped
  198.       --  string and making a recursive call using the identity mapping
  199.       --  on this mapped string. We identify the identity mapping by the
  200.       --  fact that our standard representation for Identity is empty.
  201.  
  202.       if Mapping'Last < Mapping'First then
  203.          declare
  204.             Mapped_Source : Wide_String (Source'range);
  205.  
  206.          begin
  207.             for J in Source'range loop
  208.                if Source (J) in Mapping'range then
  209.                   Mapped_Source (J) := Mapping (Source (J));
  210.                else
  211.                   Mapped_Source (J) := Source (J);
  212.                end if;
  213.             end loop;
  214.  
  215.             return Index (Mapped_Source, Pattern, Going);
  216.          end;
  217.       end if;
  218.  
  219.       if Pattern = "" then
  220.          raise Pattern_Error;
  221.       end if;
  222.  
  223.       if Going = Forward then
  224.          for J in 1 .. Source'Length - Pattern'Length + 1 loop
  225.             if Pattern = Source (J .. J + Pattern'Length - 1) then
  226.                return J + Source'First - 1;
  227.             end if;
  228.          end loop;
  229.  
  230.       else -- Going = Backward
  231.          for J in reverse 1 .. Source'Length - Pattern'Length + 1 loop
  232.             if Pattern = Source (J .. J + Pattern'Length - 1) then
  233.                return J + Source'First - J;
  234.             end if;
  235.          end loop;
  236.       end if;
  237.  
  238.       --  Fall through if no match found. Note that the loops are skipped
  239.       --  completely in the case of the pattern being longer than the source.
  240.  
  241.       return 0;